
package Sgdb::PanesWin;

use Sgdb::Utils qw( :DEFAULT
                    get_full_filename
                    tracepoints_list
                    breakpoints_list
                    ) ;

use warnings ;
use strict ;
use integer ;
use bytes ;

use Sgdb::ServicePane ;
use Sgdb::SourcePane ;
use Sgdb::Preferences ;
# use Sgdb::InlinesPane ;

my $cur_text ;                  # shortcut for current Text object
my $cur_name ;                  # shortcut for current name
                                # TODO?: use the $notebook->raised() instead
my $notebook ; # NOTE: also queried by Sgdb::ControlPanel
# our $servicewin ;
sub source_notebook {$notebook}

init () ;

sub init { 1 }

sub new {
    my $self = shift or die "whoami" ;
    my $topf = shift or die "top frame needed" ;
    my $frame = $topf -> Frame ;
                                # Perlon: this intermediate frame is yielding better geometry
                                # responses (can be considered as bug fix)

    $notebook = $frame -> NoteBook ()  -> pack ( -fill => 'both', -expand => 1 ) ;

    add_service_pane ( ) ;

    hook_add ( 'open-source-file'           => \&open_source_file,
               'close-current-source-pane'  => \&close_current_source_file,
               'new-frame-update'           => \&new_frame_update,
               'clear-all-disassembly'      => \&clear_all_disassembly,
               'close-all-sources'          => \&close_all_sources,
               'open-file-for-edit'         => \&add_file_edit_pane,
               'open-preferences-pane'      => \&add_preferences_pane,
               'refresh-breakpoints'        => sub { tp_and_bp_refresh( $cur_text, $cur_name =~ /([^\/]+)$/ )},
               'mark-tstatus-points'        => \&update_tstatus_no_hits,
               'mark-branchp-points'        => \&mark_branchp_points,

               'add-service-pane'           => \&add_service_pane,
               'add-preferences-pane'       => \&add_preferences_pane,
              ) ;

    set_key_bindings() ;
#     bindkey 'C-o' , sub { focus_on ($cur_text || $notebook ) }, ' Focus on Source Pane (if raised)'   ;
    $frame ;
}

sub set_key_bindings {

    no strict 'refs' ;
    my $w = $mainwindow ;
    foreach my $a ( ["<Meta-Up>"  , 'yviewScroll', -1, 'units'],
                    ["<Meta-Down>", 'yviewScroll',  1, 'units'],
                    ["<Meta-Home>", 'yviewMoveto',  0,        ],
                    ["<Meta-End>" , 'yviewMoveto',  1         ],
                    ["<Meta-Left>", 'xviewScroll', -1, 'units'],
                    ["<Meta-Right>",'xviewScroll',  1, 'units'],
                    ["<Meta-Prior>",'yviewScroll', -1, 'pages'],
                    ["<Meta-Next>", 'yviewScroll',  1, 'pages'],
                  ) {
        my ($key, $func, @params) = @$a ;
        $mainwindow -> bind ( $key =>
                              sub { eval { $cur_text -> $func ( @params ) ;
                                           $mainwindow -> break } } ) ;
    }

    bindkey 'C-Tab'          => [\&control_tab,0 ] , 'Next source pane' ;
    bindkey 'C-S-Tab'        => [\&control_tab,1 ] , 'Previous source pane' ;
    bindkey 'C-ISO_Left_Tab' => [\&control_tab,1 ] , 'Previous source pane' ;
}

sub control_tab {
    my $n = $notebook ;
    return unless istkwidget $n ;

    my $b = shift ;
    $b = shift while $b and ref $b ;

    my $c = $n -> raised() ;
    my @c = $n -> pages() ;
    @c = reverse @c if $b ;

    for my $i (-1 .. $#c - 1 ) {
        next unless $c eq $c[$i] ;
        $n->raise ($c[$i + 1]) ;
        return $n->break();
    }
}

sub add_service_pane {

    my $servname = ' Serv' ;

    unless ( defined $notebook->page_widget($servname) ) {

        my $frame = $notebook -> add($servname ,
                                     -label => $servname ,
                                     -anchor => 'w',
                                     ) ;

        my $text = new Sgdb::ServicePane ($frame);

        $notebook -> pageconfigure ( $servname,
                                     -raisecmd => sub {
                                         $cur_name = '' ;
                                         $cur_text = $text ;
                                     } ) ;

        $text->pack(-fill   => 'both',
                    -expand => 'y',
                    ) ;
    }
    $notebook -> raise( $servname ) ;
}

sub add_file_edit_pane {

    my $file = shift ;
    my $calback = shift ;

    $calback = sub { } unless ref $calback eq 'CODE' ;

    $file and ($file) = $file =~ /(\S*)/ ;

    $file or return telme "no file" ;

    my $name = " $file" ;

    unless ( defined $notebook->page_widget($name) ) {

        require Sgdb::FileEditPane or return telthemloud "Error: $@" ;

        my $frame = $notebook -> add ( $name,
                                      -label => ($file =~ m!([^/]+)$!)[0] || '????' ,
                                      -anchor => 'w',
                                      );

        my $text = new Sgdb::FileEditPane $frame, $file, $calback ;

        $notebook -> pageconfigure ( $name,
                                     -raisecmd => sub {
                                         $cur_name = '' ;
                                         $cur_text = $text ;
                                     } ) ;


        $text -> pack( -fill => 'both',
                       -expand => 1,
                       -pady => 0,
                       ) ;
    }

    $notebook -> raise( $name ) ;

}

sub add_preferences_pane {

    my $name = ' Pref' ;

    unless ( defined $notebook->page_widget($name) ) {

        my $frame = $notebook -> add ($name,
                                      -label => $name ,
                                      -anchor => 'w',
                                      );

        my $text = new Sgdb::Preferences $frame, @_ ;

        $notebook -> pageconfigure ( $name,
                                     -raisecmd => sub {
                                         $cur_name = '' ;
                                         $cur_text = $text ;
                                     } ) ;
    }

    $notebook -> raise( $name ) ;
}

sub open_source_file {

    my ($file, $line) = @_ ;

    return telme ("arg:", @_) unless $notebook and $file ;

    $file = get_full_filename( $file ) ;
    unbusy ;

    unless ( defined $notebook->page_widget($file) ) {

        my $frame = $notebook -> add ($file,
                                      -label => ($file =~ m!([^/]+)$!)[0] || '????' ,
                                      -anchor => 'w',
                                      );

        telthem "open file: $file" ;

        my $text = new Sgdb::SourcePane ($frame, $file) ;

        $text or return telthemloud "can't open $file";

        $notebook -> pageconfigure($file,
                                   -raisecmd => sub {
                                       $cur_text = $text ;
                                       $cur_name = $file ;
                                       tp_and_bp_refresh( $text, $file =~ m/([^\/]+)$/) ;
                                   } ,
                                   );

        $text->pack(-fill => 'both',
                    -expand => 'y',
                    ) ;
    }

    $notebook -> raise ($file) ;

    if ($line) {

        my $text = $cur_text or return telme "no cur_text" ;

        $text -> tagRemove( 'cur-line', '1.0', 'end') if
        $text -> tagRanges( 'cur-line' ) ;

        eval {
            # Perlon: this eval protects the rest of the code (and
            # the hook) from bad indexes
            $text -> see( "L$line" )  ;
            $text -> tagAdd   ( 'cur-line', "L$line", "L$line +5 c" ) ;
            $text -> markSet( 'insert', "L$line wordend" ) ;
        } ;
    }
}

sub new_frame_update {

    my $n = $notebook ;
    my ($pc, $f, $l) = @_ ;
    return if $f and $n->raised() !~ /$f$/ ;
    return unless $cur_name ;

  Sgdb::SourcePane::highlight_assembly_line( $cur_text, $pc, $l, $f) ;
}

sub set_tracepoint_and_breakpoint {

    my ($n, $type, $num, $addr, $file, $line) = @_ ;

    $file = get_full_filename( $file ) or return ;
    $file eq $cur_text or return ;

    eval {
        if (my $index =
            $cur_text -> search( -regexp => -hidden => "^$addr", "L$line")) {
            $cur_text -> tagAdd( $type, $index, "$index + 2 c" ) ;
        }
        else {
            $cur_text -> tagAdd( $type, "L$line", "L$line + 2 c" ) ;
        }
    };
}

sub tp_and_bp_refresh {

    my $t = shift ;
    my $f = shift or return ;

    $t -> tagRemove( 'loc-tracepoint',     '1.0' => 'end') ;
    $t -> tagRemove( 'loc-breakpoint',     '1.0' => 'end') ;
    $t -> tagRemove( 'loc-dis-tracepoint', '1.0' => 'end') ;
    $t -> tagRemove( 'loc-dis-breakpoint', '1.0' => 'end') ;
    $t -> tagRemove( 'loc-tstatus-mis',    '1.0' => 'end') ;
    $t -> tagRemove( 'loc-tstatus-hit',    '1.0' => 'end') ;


    foreach my $trace ( tracepoints_list ( $f ) ) {

        # 1   y   0x005263c4 0     0     in lock_lru at ../lru.c:581
        $trace =~ /(n?)\s+0x0*([a-f\d]+).*\s+(\S+):(\d+)\s*$/ or next ;

        my ($dis, $addr, $file, $line) = ($1, $2, $3, $4) ;

        eval {
            if (my $index =
                $t -> search( -regexp => -hidden =>
                              "^0x0*$addr",
                              'L' . ($line - 1) => "L$line + 100 l" )) {
                $t -> tagAdd( ( $dis ? 'loc-dis-tracepoint' : 'loc-tracepoint' ),
                              $index => "$index + 2 c"
                              ) ;
            }
            else {
                $t -> tagAdd( ( $dis ? 'loc-dis-tracepoint' : 'loc-tracepoint' ),
                              "L$line" => "L$line + 2 c" ) ;
            }
        } ;
    }
    foreach my $break ( breakpoints_list ( $f ) ) {

        # 2   breakpoint     keep y   0x005263c4 in lock_lru at ../lru.c:581
        $break =~ /(n?)\s+0x0?0?([a-f\d]+).*at\s+(\S+):(\d+)\s*$/ or next ;

        my ($dis, $addr, $file, $line) = ($1, $2, $3, $4) ;

        eval {
            if (my $index =
                $t -> search( -regexp => -hidden =>
                              "^0x$addr", '1.0')) {
                              # 'L' . ($line - 1) => "L$line + 100 l" )) {

                $t -> tagAdd( ( $dis ? 'loc-dis-breakpoint' : 'loc-breakpoint' ),
                              $index => "$index + 2 c" ) ;
            }
            else {
                $t -> tagAdd( ( $dis ? 'loc-dis-breakpoint' : 'loc-breakpoint' ),
                              "L$line" => "L$line + 2 c" ) ;
            }
        } ;
    }
}

sub update_tstatus_no_hits {

    my $res = shift   or return ;

    if ( @_ ) {
        my ( $pc, $f, $l ) = @_ ;
        hook_run 'open-source-file', $f, $l ;
        return unless $cur_text ;
        return if ( 0 > index $cur_name, $f );
        Sgdb::SourcePane::disassemble_range ( $cur_text, $f, $l ) ;
        Sgdb::SourcePane::highlight_assembly_line( $cur_text, $pc, $l, $f) ;
    }

    my $t = $cur_text or return ;
    $t -> tagRanges( 'asm-addr') or return ;

    $t -> tagRemove( 'loc-tstatus-mis', '1.0', 'end') ;
    $t -> tagRemove( 'loc-tstatus-hit', '1.0', 'end') ;

    my $loc = '1.0' ;
    my $index ;

    if ( ref $res eq 'ARRAY' ) {

        while ( @$res ) {
            my ( $addr, $val ) = ( shift @$res, shift @$res ) ;
            if ( $index = $t -> search( -regexp => -hidden =>
                                        "^0x0*$addr", $loc ) ) {
                $t -> tagAdd( ($val ? 'loc-tstatus-hit' : 'loc-tstatus-mis') ,
                              "$index +8 c" => "$index lineend +1 c"
                              ) ;
#todo: sort?                 $loc = $index ;
            }
        }
    }
    else {
        foreach my $addr ( sort {hex $a <=> hex $b } $res =~ /^\s*\d+\s+0x([a-f\d]+)\s+0x0/gm ) {

            if ( $index = $t -> search( -regexp => -hidden =>
                                        "^0x0*$addr", $loc ) ) {

                $t -> tagAdd( 'loc-tstatus-mis' ,
                              "$index +2 c" => "$index +8 c"
                            ) ;
# todo: sort ?                $loc = $index ;
            }
        }
    }
}

sub mark_branchp_points {

    my ($f, $l, $res, $start, $samples_type) = @_ ;

    hook_run 'open-source-file', $f, $l ;
    my $t =    $cur_text     or return ;
    0 <= index $cur_name, $f or return ;

    Sgdb::SourcePane::forget_disassemble( $t ) ;
    if ($samples_type == 1) {
        Sgdb::SourcePane::disassemble_range ( $t, $f, $l, 'branchp', $res, qr/(:?\s|$)j/) ;
    } else {
        Sgdb::SourcePane::disassemble_range ( $t, $f, $l, 'BRANCHP', $res, qr/(:?\s|$)j/, $start) ;
    }
}

sub clear_all_disassembly {

    my $n = $notebook  ;

    foreach my $c ( $n -> children ) {

        foreach my $t ( $c -> children ) {

            eval { $t -> tagRanges ( 'asm-comm' ) and Sgdb::SourcePane::forget_disassemble( $t ) } ;
        }
    }
}

sub close_current_source_file {

    my $n = $notebook ;
    my $r = $n -> raised () or return telme 'nothing up' ;
    $n -> delete ( $r ) ;
}

sub close_all_sources {

    my $n = $notebook ;

    foreach my $page ( $n -> pages() ) {

        $n -> delete ( $page ) unless substr ( $page, 0, 1) eq ' ' ;
    }
}


